home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1997 #3 / Amiga Plus CD - 1997 - No. 03.iso / pd / programmierung / alienbreed3d2_src / amos / 256floor.amos / 256floor.amosSourceCode
AMOS Source Code  |  1997-01-31  |  2KB  |  106 lines
  1. Screen Open 1,640,24,2,Hires
  2. Palette $8,$FF0 : Paper 0 : Pen 1 : Curs Off : Flash Off : Extension_12_0380 -1
  3. Box 0,4 To 639,20 : Wait Vbl : Screen Display 1,,Y Hard(1,72),,
  4.  
  5. Reserve As Work 15,65536
  6. Trap Bload "ab3:includes/256pal",15
  7. If Errtrap
  8.    Locate 0,1 : Centre "Could not load 'ab3:includes/256pal'"
  9.    Wait Key 
  10.    Edit 
  11. End If 
  12. Dim R(255),G(255),B(255),PR(63),PG(63),PB(63),CO(63)
  13. S=Start(15)
  14. For A=0 To 255
  15.    R(A)=Deek(S) : Add S,2
  16.    G(A)=Deek(S) : Add S,2
  17.    B(A)=Deek(S) : Add S,2
  18. Next 
  19.  
  20.  
  21. Reserve As Work 14,100000
  22. For A=1 To 16
  23.    M$="ab3:graphics/floors/floor."+Str$(A)-" "
  24.    Screen 1 : Locate 0,1 : Centre "   Loading Picutre...   " : Screen 0
  25.    Trap Load Iff M$,0
  26.    If Errtrap
  27.       Screen 1
  28.       Locate 0,1
  29.       Centre "Unable to load 'ab3:graphics/floors/floor."+(Str$(A)-" ")+"'"
  30.       Wait Key 
  31.       Edit 
  32.    End If 
  33.    Screen To Front 1
  34.    Bload M$,Start(14)
  35.    S=Hunt(Start(14) To Start(14)+10000,"CMAP")+8
  36.    For B=0 To 31
  37.       PR(B)=Peek(S) : Add S,1
  38.       PG(B)=Peek(S) : Add S,1
  39.       PB(B)=Peek(S) : Add S,1
  40.       PR(B+32)=PR(B)/2
  41.       PG(B+32)=PG(B)/2
  42.       PB(B+32)=PB(B)/2
  43.    Next 
  44.  
  45.    Screen 1 : Locate 0,1 : Centre "  Matching Colours...   " : Screen 0
  46.  
  47.    For B=0 To 63
  48.       
  49.       ND=100000000 : T=0
  50.       For Z=0 To 255
  51.          D=Abs(R(Z)-PR(B))+Abs(G(Z)-PG(B))+Abs(B(Z)-PB(B))
  52.          If D<ND Then ND=D : T=Z
  53.          If D=0 Then Z=255
  54.       Next 
  55.       
  56.       CO(B)=T
  57.       
  58.    Next 
  59.    
  60.    Screen 1 : Locate 0,1 : Centre "   Storing Texture...   " : Screen 0
  61.  
  62.    B=A-1
  63.    S=Start(15)+(B mod 4)+(B/4)*256
  64.    For X=0 To 63 : For Y=0 To 63
  65.          Poke S+X*4+Y*1024,CO( Extension_12_044C(X,Y))
  66.           Extension_12_036E X,Y,0
  67.    Next : Next 
  68.    
  69. Next 
  70. Trap Bsave "ab3:includes/floortile",Start(15) To Start(15)+65536
  71. If Errtrap
  72.    Screen 1
  73.    Locate 0,1 : Centre "Unable to save 'ab3:includes/floortile'"
  74.    Wait Key 
  75.    Edit 
  76. End If 
  77.  
  78. 'N=Start(14) 
  79. 'For A=32 To 1 Step -1 
  80. '   For QB=0 To 255
  81. '      
  82. '      R=(R(QB)*A)/32
  83. '      G=(G(QB)*A)/32
  84. '      B=(B(QB)*A)/32
  85. '      
  86. '      ND=100000000 : T=0
  87. '      For Z=0 To 255
  88. '         D=Abs(R(Z)-R)+Abs(G(Z)-G)+Abs(B(Z)-B)
  89. '         If D<ND Then ND=D : T=Z
  90. '         If D=0 Then Z=255
  91. '      Next  
  92. '      
  93. '      Doke N,(T*256)+T : Add N,2
  94. '      
  95. '   Next 
  96. 'Next  
  97. 'Bsave "ab3:includes/floor256pal",Start(14) To N 
  98.  
  99. Screen 1 : Locate 0,1 : Centre "All Done, Press any key..." : Screen 0
  100. T=Timer
  101. Repeat 
  102.    I$=Inkey$
  103.    Multi Wait 
  104. Until(I$<>"") or T>500
  105.  
  106. Edit